home *** CD-ROM | disk | FTP | other *** search
/ PC-SIG: World of Games / PC-SIG World of Games (CDRM1080710) (1993).iso / 262 / APLAYER.ASC < prev    next >
Text File  |  1984-02-18  |  13KB  |  274 lines
  1. 10000 '*************************************************************
  2. 10010 '*****    PC-GOLF    THE GOLFER's PROGRAM     PC-GOLF    *****
  3. 10020 '*****    Version 1.3  (C) 1982,1983,1984 Ed Chandler    *****
  4. 10030 '*************************************************************
  5. 10040 '+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  6. 10050 '     3. GET THE GOLFERS ROSTER
  7. 10060 '+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  8. 10070 CLS:PRINT MNU3$:PRINT
  9. 10072 IF ROS=0 THEN 10080
  10. 10075 DEF SEG=&H40:I%=PEEK(&H17):I%=I% OR 32:POKE &H17,I% 'num lock on
  11. 10080 MNU1$="1.  REVIEW the golfer's roster.":PRINT SPC(3);MNU1$
  12. 10090 MNU2$="2.  ADD a new player to the roster.":PRINT SPC(3);MNU2$
  13. 10100 MNU4$="3.  CHANGE the golfer's roster.":PRINT SPC(3);MNU4$
  14. 10110 MNU5$="4.  DELETE a player from the roster.":PRINT SPC(3);MNU5$
  15. 10120 MNU6$="5.  ERASE a player's score sheet.":PRINT SPC(3)MNU6$
  16. 10130 PRINT SPC(3);MNURT$:PRINT
  17. 10140 M1$="key":M2$="(1,2,3,4,5 OR M). ":GOSUB 570
  18. 10150 IF KB=1 THEN 10250 'review
  19. 10160 IF KB=2 THEN 10320 'add
  20. 10170 IF KB=3 THEN 11080 'update
  21. 10180 IF KB=4 THEN 12030 'delete
  22. 10190 IF KB=5 THEN 12270 'erase scores
  23. 10200 IF KB$="M" OR KB$="m" THEN 530 'back to main
  24. 10210 GOSUB 610:GOTO 10070
  25. 10220 '+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  26. 10230 '     3.1. Review Player Roster
  27. 10240 '+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  28. 10250 GOSUB 10260:GOTO 10070 'return
  29. 10260 CLS:PRINT MNU1$:X=1:GOSUB 550 'display player roster
  30. 10270 IF PR=0 THEN GOSUB 580 ELSE GOSUB 590
  31. 10280 RETURN
  32. 10290 '+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  33. 10300 '     3.2. ADD a Player to the Roster
  34. 10310 '+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  35. 10320 GOSUB 10330:GOTO 10070 'return
  36. 10330 CLS:PRINT MNU2$:IF CACT>0 THEN 10360
  37. 10340 PRINT:PRINT"To add a player to the roster you must first"
  38. 10350 PRINT"add his home course to the course directory.":GOSUB 580:RETURN
  39. 10360 IF PACT<PMAX THEN 10400 'tra if room for one more
  40. 10370 PRINT:PRINT "The Player Roster is full.":PRINT
  41. 10380 PRINT "To add a player you must first"
  42. 10390 PRINT "delete a player from the roster.":GOSUB 580:RETURN
  43. 10400 RESTORE 815:GOSUB 600
  44. 10410 IF KB$<>"Y" THEN RETURN
  45. 10420 CLS:PRINT MNU2$:PRINT:PRINT"Are you adding a man or woman golfer?"
  46. 10430 PRINT:PRINT" 1.  Man":PRINT" 2.  Woman"
  47. 10440 PRINT:LINE INPUT"ENTER the correct line number. ";KB$
  48. 10450 KB=VAL(KB$):IF KB<1 OR KB>2 THEN GOSUB 610:GOTO 10420
  49. 10460 IF KB=1 THEN T1$=MSEX$ ELSE T1$=FSEX$
  50. 10470 CLS:PRINT MNU2$:PRINT
  51. 10480 LINE INPUT "ENTER the name of the player you're adding. ";KB$
  52. 10490 L=LEN(KB$):IF L>0 AND L<=NMAX THEN 10530
  53. 10500 PRINT:PRINT"Please limit the name to ";NMAX;" letters maximum."
  54. 10510 GOSUB 580:GOTO 10470
  55. 10520 '+++++     find PLAYER ID # for the addition
  56. 10530 GOSUB 700:GOSUB 660 'open PDIR,DAT
  57. 10540 FOR I=1 TO PMAX:GET #4,I:RN=CVI(A4$) 'ID #
  58. 10550 IF RN=0 THEN RN=I:GOTO 10610 'USE THIS SLOT FOR PLAYER ID
  59. 10560 NEXT:IF RN<PMAX THEN 10610 'TRA IF ROOM FOR ONE MORE
  60. 10570 PRINT:PRINT "The Player Roster is full.":PRINT
  61. 10580 PRINT "To add a player you must first":PRINT "delete one from the roster."
  62. 10590 CLOSE #4:GOSUB 580:RETURN
  63. 10600 '+++++     store ID # and name
  64. 10610 RSET A4$=MKI$(RN):LSET B4$=KB$:RSET F4$=T1$ 'ID, name, sex
  65. 10620 CLS:PRINT MNU2$:PRINT
  66. 10630 LINE INPUT"ENTER the players phone number, e.g. 555-1212 . ";KB$
  67. 10640 L=LEN(KB$):IF L=8 THEN 10670
  68. 10650 PRINT:PRINT"Please limit the phone number to 8 characters."
  69. 10660 GOSUB 580:GOTO 10620
  70. 10670 RSET C4$=KB$ 'phone #
  71. 10680 '+++++     handicap     +++++
  72. 10690 CLS:PRINT MNU2$:PRINT
  73. 10700 LINE INPUT"ENTER the players handicap. ",KB$
  74. 10710 GOSUB 11650:IF X=-1 THEN 10690
  75. 10720 RSET D4$=KB$+"*" 'h'cap
  76. 10730 '+++++     get players home course ID     +++++
  77. 10740 CLS:PRINT MNU2$:M1=0:GOSUB 540 'display course list
  78. 10750 PRINT:LINE INPUT"ENTER the line number of the players home course. ";KB$
  79. 10760 KB=VAL(KB$):IF KB>0 AND KB<= CMAX AND TMP(KB)=KB THEN 10790 'entry ok
  80. 10770 PRINT:PRINT "Please choose a line number from the list."
  81. 10780 GOSUB 580:GOTO 10740
  82. 10790 RSET E4$=KB$ 'course id#
  83. 10800 '+++++     customary tee box     +++++
  84. 10810 CLS:PRINT MNU2$:PRINT
  85. 10820 GOSUB 10840:GOTO 10970
  86. 10830 '+++++
  87. 10840 GOSUB 655:GET #3,KB:CLOSE #3 'get course
  88. 10850 PRINT"Which tee will this player normally use?":PRINT:T=1
  89. 10860 IF CVS(K2$)<>0 THEN PRINT USING"   #.  GOLD";T:T$(T)="g":T=T+1
  90. 10870 IF CVS(L2$)<>0 THEN PRINT USING"   #.  BLUE";T:T$(T)="b":T=T+1
  91. 10880 IF CVS(F2$)<>0 THEN PRINT USING"   #.  WHITE";T:T$(T)="w":T=T+1
  92. 10890 IF CVS(I2$)<>0 THEN PRINT USING"   #.  RED";T:T$(T)="r":T=T+1
  93. 10900 PRINT:LINE INPUT"ENTER the line number of the player's usual tee. ";KB$
  94. 10910 KB=VAL(KB$):IF KB>0 AND KB<T THEN 10940
  95. 10920 PRINT:PRINT"Please choose a line number from the list."
  96. 10930 GOSUB 580:CLS:GOTO 10850
  97. 10940 RSET G4$=T$(KB) 'normal tee box
  98. 10950 RETURN
  99. 10960 '+++++     WRITE PLAYER DIRECTORY FILE PDIR.DAT     +++++
  100. 10970 PUT #4,RN:CLOSE #4
  101. 10980 '+++++     UPDATE PACT. REWRITE INIT.DAT FILE     +++++
  102. 10990 X=1:GOSUB 630 'UPDATE PACT-INIT.DAT FILE
  103. 11000 '+++++     INITIALIZE PLAYER.DAT FILE     +++++
  104. 11010 GOSUB 670:GOSUB 672:RSET B5$=E4$:RSET C5$=D4$ ' inits
  105. 11020 PUT #5,RN:CLOSE #5
  106. 11030 CLS:PRINT "Addition completed for ";B4$:X=1:GOSUB 550 'show roster
  107. 11040 GOSUB 580:RETURN
  108. 11050 '+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  109. 11060 '     3.3. UPDATE the Player Roster   PDIR.DAT
  110. 11070 '+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  111. 11080 GOSUB 11090:GOTO 10070 'return
  112. 11090 CLS:PRINT MNU4$
  113. 11100 '
  114. 11110 RESTORE 816:GOSUB 600
  115. 11120 IF KB$<>"Y" THEN RETURN
  116. 11130 CLS:PRINT MNU4$:X=1:GOSUB 550 'show roster
  117. 11140 IF PR=0 THEN GOSUB 580:RETURN 'empty roster
  118. 11150 PRINT:LINE INPUT"ENTER the line number of the player you want to change. ";KB$
  119. 11160 KB=VAL(KB$):IF KB>0 AND KB<=PMAX AND TMP(KB)=KB THEN RN=KB:GOTO 11200
  120. 11170 '
  121. 11180 GOSUB 611:GOTO 11130
  122. 11190 '+++++     change a field     +++++
  123. 11200 GOSUB 660:GET #4,RN 'get record to be changed
  124. 11210 GOSUB 670:GET #5,RN 'player.dat
  125. 11220 KB$=B4$:GOSUB 700:PN$=KB$ 'player name
  126. 11230 CLS:PRINT MNU4$:PRINT
  127. 11240 PRINT "LINE #"
  128. 11250 PRINT " 1. Player's Name";SPC(5);B4$
  129. 11260 PRINT " 2. Telephone    ";SPC(5);C4$
  130. 11270 PRINT " 3. Handicap     ";SPC(5);D4$
  131. 11280 N=VAL(E4$):T$=MID$(GCDIR$(N),3,NMAX)
  132. 11290 PRINT " 4. Home Course  ";SPC(5);T$:KB$=T$:GOSUB 700:CN$=KB$ 'name
  133. 11300 T$="Gold":IF G4$="b" THEN T$="Blue"
  134. 11310 IF G4$="w" THEN T$="White" ELSE IF G4$="r" THEN T$="Red"
  135. 11320 PRINT " 5. Usual tee box";SPC(5)T$
  136. 11330 PRINT:LINE INPUT"ENTER the number of the line you want to change. ";KB$
  137. 11340 KB=VAL(KB$):IF KB>0 AND KB<=5 THEN 11390
  138. 11350 PRINT:PRINT "Please choose a line number from the list."
  139. 11360 GOSUB 580:GOTO 11230
  140. 11370 '
  141. 11380 '
  142. 11390 KB$=INKEY$:IF KB$<>"" THEN 11390
  143. 11400 '+++++     player name     +++++
  144. 11410 IF KB<>1 THEN 11480
  145. 11420 CLS:PRINT MNU4$
  146. 11430 PRINT:LINE INPUT"ENTER the replacement name. ";KB$
  147. 11440 IF LEN(KB$)>0 AND LEN(KB$)<=NMAX THEN GOSUB 700:LSET B4$=KB$:GOTO 11980
  148. 11450 PRINT:PRINT"The name is too long. ";NMAX;" letters maximum. Try again."
  149. 11460 GOSUB 580:GOTO 11420
  150. 11470 '+++++     phone #     +++++
  151. 11480 IF KB<>2 THEN 11560
  152. 11490 CLS:PRINT MNU4$
  153. 11500 PRINT:LINE INPUT"ENTER the replacement phone number. ";KB$
  154. 11510 L=LEN(KB$):IF L=8 THEN 11540
  155. 11520 PRINT:PRINT"Please limit the phone number to 8 characters."
  156. 11530 GOSUB 580:GOTO 11410
  157. 11540 RSET C4$=KB$:GOTO 11980 'phone #
  158. 11550 '+++++     handicap     +++++
  159. 11560 IF KB<>3 THEN 11770
  160. 11570 T$=RIGHT$(C5$,1):IF T$<>"T" AND T$<>" " THEN 11610 'no hcap yet
  161. 11580 PRINT:PRINT"A handicap of ";C5$;" has been established for ";PN$;"."
  162. 11590 PRINT:PRINT"You cannot change an established handicap."
  163. 11600 GOSUB 580:GOTO 11980
  164. 11610 CLS:PRINT MNU4$
  165. 11620 PRINT:LINE INPUT"ENTER the replacement handicap. ";KB$
  166. 11630 GOSUB 11650:IF X=0 THEN 11750 ELSE 11610
  167. 11640 '+++++
  168. 11650 X=0:T$=LEFT$(KB$,1):L=LEN(KB$):IF L<1 OR L>2 THEN 11700
  169. 11660 N=VAL(LEFT$(KB$,2)):IF T$="+" THEN N=VAL(MID$(KB$,2,1))
  170. 11670 KB$=LEFT$(KB$,2):IF N<0 OR N>40 THEN 11700
  171. 11680 IF T$="-" THEN 11700
  172. 11690 IF F4$=MSEX$ AND N<=36 OR F4$=FSEX$ THEN RETURN
  173. 11700 PRINT:PRINT"Handicap limits are:":PRINT
  174. 11710 PRINT" Men    0 through 36"
  175. 11720 PRINT" Women  0 through 40"
  176. 11730 PRINT" Scratch  use + sign"
  177. 11740 GOSUB 580:X=-1:RETURN
  178. 11750 T1$=KB$+"*":LSET D4$=T1$:RSET C5$=D4$:GOTO 11980 'h'cap
  179. 11760 '+++++     course ID     +++++
  180. 11770 IF KB<>4 THEN 11950
  181. 11780 CLS:PRINT MNU4$:M1=0:GOSUB 540 'show courses
  182. 11790 PRINT:LINE INPUT"ENTER the line number of the NEW home course. ";KB$
  183. 11800 KB=VAL(KB$):IF KB>0 AND KB<=CMAX AND TMP(KB)=KB THEN 11830 'entry ok
  184. 11810 PRINT:PRINT "Please choose a line number from the list.."
  185. 11820 GOSUB 580:GOTO 11780
  186. 11830 IF B5$="00" OR INSTR(CN$,"*")<>0 THEN 11920 'tra if no home course yet
  187. 11840 PRINT:PRINT"A home course, ";CN$;", is already assigned for ";PN$;"."
  188. 11850 PRINT"Changing or reassigning home courses will erase all recorded"
  189. 11860 PRINT"gross scores and putts.  Scores will have to be built up at"
  190. 11870 PRINT"the new or reassigned home course."
  191. 11880 '
  192. 11890 PRINT:PRINT"This will not affect the player's adjusted gross scores nor"
  193. 11900 PRINT"the differentials used to calculate the player's handicap."
  194. 11910 RESTORE 816:GOSUB 600:IF KB$<>"Y" THEN 11980
  195. 11920 GOSUB 671:RSET E4$=STR$(KB):RSET B5$=E4$ 'course ID number
  196. 11930 LSET A5$="I" 'set invalid data flag
  197. 11940 '+++++     tee box     +++++
  198. 11950 CLS:PRINT MNU4$:PRINT
  199. 11960 KB=VAL(E4$):GOSUB 10840 'get new tee
  200. 11970 '+++++     update PDIR.DAT, PLAYER.DAT     +++++
  201. 11980 PUT #4,RN:PUT #5,RN:CLOSE #5,#4
  202. 11990 CLS:PRINT "UPDATE completed for ";B4$:X=1:GOSUB 550:GOSUB 580:RETURN
  203. 12000 '+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  204. 12010 '     3.4. Delete a player from the directory
  205. 12020 '+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  206. 12030 GOSUB 12040:GOTO 10070
  207. 12040 CLS:PRINT MNU5$
  208. 12050 '
  209. 12060 RESTORE 819:GOSUB 600:IF KB$<>"Y" THEN RETURN
  210. 12070 CLS:PRINT MNU5$
  211. 12080 X=1:GOSUB 550 'show roster
  212. 12090 IF PR=0 THEN GOSUB 580:RETURN
  213. 12100 '
  214. 12110 PRINT:LINE INPUT"ENTER the line number of the player you want to delete. ";KB$
  215. 12120 KB=VAL(KB$):IF KB>0 AND KB<=PMAX AND TMP(KB)=KB THEN RN=KB:GOTO 12150
  216. 12130 GOSUB 611:GOTO 12070
  217. 12140 '+++++
  218. 12150 RESTORE 820:GOSUB 600
  219. 12160 IF KB$<>"Y" THEN 12040
  220. 12170 X=-1:GOSUB 630 'reduce PACT count
  221. 12180 GOSUB 660:GET #4,RN
  222. 12190 M1$=B4$:GOSUB 661 'inits
  223. 12200 PUT #4,RN:CLOSE #4 'empty slot
  224. 12210 GOSUB 670:GOSUB 672:PUT #5,RN:CLOSE #5 'empty slot
  225. 12220 CLS:PRINT "Deletion completed for ";M1$
  226. 12230 X=1:GOSUB 550:GOSUB 580:RETURN
  227. 12240 '+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  228. 12250 '     5. ERASE a players gross scores
  229. 12260 '+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  230. 12270 GOSUB 12280:GOTO 10070
  231. 12280 CLS:PRINT MNU6$
  232. 12290 '
  233. 12300 RESTORE 835:GOSUB 600
  234. 12310 IF KB$<>"Y" THEN RETURN
  235. 12320 CLS:PRINT MNU6$:X=1:GOSUB 550 'show roster
  236. 12330 IF PR=0 THEN GOSUB 580:RETURN
  237. 12340 PRINT:LINE INPUT"ENTER the player's line number for erasing scores. ";KB$
  238. 12350 KB=VAL(KB$):IF KB>0 AND KB<=PMAX AND TMP(KB)=KB THEN RN=KB:GOTO 12380
  239. 12360 '
  240. 12370 GOSUB 611:GOTO 12320
  241. 12380 RESTORE 813:GOSUB 600
  242. 12390 IF KB$<>"Y" THEN 12280
  243. 12400 CLS:PRINT MNU6$:PRINT
  244. 12410 PRINT SPC(4)"1.  ERASE the gross scores for all rounds."
  245. 12420 PRINT SPC(4)"2.  ERASE the putting scores for all rounds."
  246. 12430 PRINT SPC(4)"3.  ERASE both the gross and putting scores."
  247. 12440 PRINT SPC(4)"4.  None of the above.  Don't erase anything."
  248. 12450 PRINT:PRINT SPC(8)"NOTE: This will not affect the adjusted gross scores"
  249. 12460 PRINT SPC(14)"used in calculating the players USGA handicap."
  250. 12470 PRINT:M1$="PRESS the number of your choice. (1,2,3 or 4) ":GOSUB 560
  251. 12480 IF KB>0 AND KB<5 THEN 12510
  252. 12490 PRINT:PRINT"You must choose a number from the list. Try again."
  253. 12500 GOSUB 580:GOTO 12400
  254. 12510 IF KB=4 THEN 12280 'save the day
  255. 12520 RESTORE 814:GOSUB 600:IF KB$<>"Y" THEN 12400
  256. 12530 GOSUB 660:GET#4,RN:CLOSE #4
  257. 12540 GOSUB 670:GET #5,RN:IF KB=2 THEN 12600
  258. 12550 '+++++     scores
  259. 12560 RSET E5$=MKI$(0):LSET F5$=STRING$(40,E5$):LSET G5$=STRING$(36,E5$)
  260. 12570 LSET H5$=STRING$(18,"9"):RSET I5$=MKI$(999)
  261. 12580 '+++++     putts
  262. 12590 IF KB<>3 THEN 12620
  263. 12600 RSET J5$=MKI$(0):LSET K5$=STRING$(40,J5$):LSET L5$=STRING$(36,J5$)
  264. 12610 LSET M5$=STRING$(18,"9"):RSET N5$=MKI$(999)
  265. 12620 PUT #5,RN:CLOSE #5
  266. 12630 CLS:PRINT MNU6$:PRINT:PRINT"Erasure completed for ";B4$
  267. 12640 GOSUB 580:RETURN
  268. 14000 '+++++     grunt work
  269. 14010 DELETE 490-9999
  270. 14020 SAVE"b:player.asc",A
  271. 14030 RUN"b:main.bas"
  272. 15000 'for chain delete
  273. 4000 '+++++     grunt work
  274. 14010 D